home *** CD-ROM | disk | FTP | other *** search
/ Amiga Tools 5 / Amiga Tools 5.iso / tools / developer-tools / e-tools / egui-tools / src / newmousetest.e < prev    next >
Encoding:
Text File  |  1996-06-15  |  6.7 KB  |  191 lines
  1. -> mousetest.e - Read position and button events from the mouse.
  2. -> Modified for use with the middle-Mouse-Button by TurricaN
  3. -> From the DARK FRONTIER (Grundler Mathias)
  4. -> Modifications are marked with a  -> (!)
  5.  
  6. OPT OSVERSION=37
  7.  
  8. MODULE 'devices/inputevent',
  9.        'exec/ports',
  10.        'graphics/gfxbase',
  11.        'graphics/rastport',
  12.        'graphics/text',
  13.        'intuition/intuition',
  14.        'intuition/screens'
  15.  
  16. ENUM ERR_NONE, ERR_DRAW, ERR_PUB, ERR_WIN
  17.  
  18. RAISE ERR_DRAW IF GetScreenDrawInfo()=NIL,
  19.       ERR_PUB  IF LockPubScreen()=NIL,
  20.       ERR_WIN  IF OpenWindowTagList()=NIL
  21.  
  22. -> E-Note: C version should use this for a string...
  23. CONST BUFSIZE=15
  24.  
  25. -> Something to use to track the time between messages to test for
  26. -> double-clicks.
  27. OBJECT myTimeVal
  28.   leftSeconds,  leftMicros
  29.   midSeconds,   midMicros       -> (!)
  30.   rightSeconds, rightMicros
  31. ENDOBJECT
  32.  
  33. PROC main() HANDLE
  34.   DEF win=NIL:PTR TO window, scr=NIL:PTR TO screen,
  35.       dr_info=NIL:PTR TO drawinfo, width, gfx:PTR TO gfxbase
  36.  
  37.   -> Lock the default public screen in order to read its DrawInfo data
  38.   scr:=LockPubScreen(NIL)
  39.  
  40.   dr_info:=GetScreenDrawInfo(scr)
  41.  
  42.   -> Use wider of space needed for output (18 chars and spaces) or titlebar
  43.   -> text plus room for titlebar gads (approx 18 each)
  44.   -> E-Note: get the right type for gfxbase
  45.   gfx:=gfxbase
  46.   width:=Max(gfx.defaultfont.xsize * 18,
  47.              (18*2)+TextLength(scr.rastport, 'MouseTest', STRLEN))
  48.  
  49.   win:=OpenWindowTagList(NIL,
  50.                         [WA_TOP,    20,
  51.                          WA_LEFT,   100,
  52.                          WA_INNERWIDTH,  width,
  53.                          WA_HEIGHT, (2*gfx.defaultfont.ysize)+
  54.                                     scr.wbortop+scr.font.ysize+1+scr.wborbottom,
  55.                          WA_FLAGS, WFLG_DEPTHGADGET OR WFLG_CLOSEGADGET OR
  56.                                      WFLG_ACTIVATE  OR WFLG_REPORTMOUSE OR
  57.                                      WFLG_RMBTRAP   OR WFLG_DRAGBAR,
  58.                          WA_IDCMP, IDCMP_CLOSEWINDOW OR IDCMP_RAWKEY OR
  59.                                      IDCMP_MOUSEMOVE OR IDCMP_MOUSEBUTTONS,
  60.                          WA_TITLE, 'MouseTest',
  61.                          WA_PUBSCREEN, scr,
  62.                          NIL])
  63.  
  64.   WriteF('Monitors the Mouse:\n')
  65.   WriteF('    Move Mouse, Click and DoubleClick in Windows\n')
  66.  
  67.   SetAPen(win.rport, dr_info.pens[TEXTPEN])
  68.   SetBPen(win.rport, dr_info.pens[BACKGROUNDPEN])
  69.   SetDrMd(win.rport, RP_JAM2)
  70.  
  71.   process_window(win)
  72.  
  73. EXCEPT DO
  74.   IF win THEN CloseWindow(win)
  75.   IF dr_info THEN FreeScreenDrawInfo(scr, dr_info)
  76.   IF scr THEN UnlockPubScreen(NIL, scr)
  77.   SELECT exception
  78.   CASE ERR_DRAW; WriteF('Error: Failed to get DrawInfo for screen\n')
  79.   CASE ERR_PUB;  WriteF('Error: Failed to lock public screen\n')
  80.   CASE ERR_WIN;  WriteF('Error: Failed to open window\n')
  81.   ENDSELECT
  82. ENDPROC
  83.  
  84. -> process_window() - Simple message loop for processing IntuiMessages
  85. PROC process_window(win:PTR TO window)
  86.   -> E-Note: C version failed to use BUFSIZE!
  87.   DEF going, msg:PTR TO intuimessage, class, tv, prt_buff[BUFSIZE]:STRING,
  88.       xText, yText  -> Places to position text in window
  89.  
  90.   -> E-Note: going rather than done saves a lot of Not()-ing
  91.   going:=TRUE
  92.   tv:=[0, 0, 0, 0]:myTimeVal
  93.   xText:=win.borderleft+(win.ifont.xsize*2)
  94.   yText:=win.bordertop+3+win.ifont.baseline
  95.  
  96.   -> E-Note: we can't use WaitIMessage() because we want mousex, mousey
  97.   WHILE going
  98.     Wait(Shl(1, win.userport.sigbit))
  99.     WHILE going AND (msg:=GetMsg(win.userport))
  100.       class:=msg.class
  101.       SELECT class
  102.       CASE IDCMP_CLOSEWINDOW
  103.         going:=FALSE
  104.  
  105.       -> NOTE NOTE NOTE:  If the mouse queue backs up a lot, Intuition will
  106.       -> start dropping MOUSEMOVE messages off the end until the queue is
  107.       -> serviced.  This may cause the program to lose some of the MOUSEMOVE
  108.       -> events at the end of the stream.
  109.       ->
  110.       -> Look in the window structure if you need the true position of the
  111.       -> mouse pointer at any given time.  Look in the MOUSEBUTTONS message if
  112.       -> you need position when it clicked.  An alternate to this processing
  113.       -> would be to set a flag that a mousemove event arrived, then print the
  114.       -> position of the mouse outside of a "WHILE GetMsg()" loop.  This allows
  115.       -> a single processing call for many mouse events, which speeds up
  116.       -> processing A LOT!  Something like:
  117.       ->
  118.       -> WHILE GetMsg()
  119.       ->   IF class=IDCMP_MOUSEMOVE THEN mouse_flag:= TRUE
  120.       ->    ReplyMsg()  -> NOTE: copy out all needed fields first !
  121.       -> ENDWHILE
  122.       -> IF mouse_flag
  123.       ->   process_mouse_event()
  124.       ->   mouse_flag:=FALSE
  125.       -> ENDIF
  126.       ->
  127.       -> You can also use IDCMP_INTUITICKS for slower paced messages (all
  128.       -> messages have mouse coordinates.)
  129.       CASE IDCMP_MOUSEMOVE
  130.     -> Show the current position of the mouse relative to the upper left
  131.         -> hand corner of our window
  132.     Move(win.rport, xText, yText)
  133.     StringF(prt_buff, 'X=\d[5] Y=\d[5]', msg.mousex, msg.mousey)
  134.         Text(win.rport, prt_buff, BUFSIZE)
  135.       CASE IDCMP_MOUSEBUTTONS
  136.         doButtons(msg, tv)
  137.       ENDSELECT
  138.       ReplyMsg(msg)
  139.     ENDWHILE
  140.   ENDWHILE
  141. ENDPROC
  142.  
  143. -> Show what mouse buttons where pushed
  144. PROC doButtons(msg:PTR TO intuimessage, tv:PTR TO myTimeVal)
  145.   DEF code
  146.   IF msg.qualifier AND (IEQUALIFIER_LSHIFT OR IEQUALIFIER_RSHIFT)
  147.     WriteF('Shift ')
  148.   ENDIF
  149.  
  150.   code:=msg.code
  151.   SELECT code
  152.   CASE SELECTDOWN
  153.     WriteF('Left Button Down at X=\d Y=\d', msg.mousex, msg.mousey)
  154.     IF DoubleClick(tv.leftSeconds, tv.leftMicros, msg.seconds, msg.micros)
  155.       WriteF(' DoubleClick!')
  156.     ELSE
  157.       tv.leftSeconds:=msg.seconds
  158.       tv.leftMicros:=msg.micros
  159.       tv.rightSeconds:=0
  160.       tv.rightMicros:=0
  161.     ENDIF
  162.   CASE SELECTUP
  163.     WriteF('Left Button Up   at X=\d Y=\d', msg.mousex, msg.mousey)
  164.   CASE MENUDOWN
  165.     WriteF('Right Button Down at X=\d Y=\d', msg.mousex, msg.mousey)
  166.     IF DoubleClick(tv.rightSeconds, tv.rightMicros, msg.seconds, msg.micros)
  167.       WriteF(' DoubleClick!')
  168.     ELSE
  169.       tv.leftSeconds:=0
  170.       tv.leftMicros:=0
  171.       tv.rightSeconds:=msg.seconds
  172.       tv.rightMicros:=msg.micros
  173.     ENDIF
  174.   CASE MENUUP
  175.     WriteF('Right Button Up   at X=\d Y=\d', msg.mousex, msg.mousey)
  176.   CASE MIDDLEDOWN               -> (!)
  177.     WriteF('Middle Button Down at X=\d Y|\d', msg.mousex, msg.mousey)   -> (!)
  178.     IF DoubleClick(tv.midSeconds, tv.midMicros, msg.seconds, msg.micros)-> (!)
  179.       WriteF(' DoubleClick!')   -> (!)
  180.     ELSE                        -> (!)
  181.       tv.midSeconds:=0          -> (!)
  182.       tv.midMicros:=0           -> (!)
  183.       tv.midSeconds:=msg.seconds-> (!)
  184.       tv.midMicros:=msg.micros  -> (!)
  185.     ENDIF                       -> (!)
  186.   CASE MIDDLEUP                 -> (!)
  187.     WriteF('Middle Button UP at X=\d Y|\d', msg.mousex, msg.mousey)     -> (!)
  188.   ENDSELECT
  189.   WriteF('\n')
  190. ENDPROC
  191.